home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / bbs / pcsuni1.zip / VRS502.ZIP / VRS-M802.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1997-04-06  |  8KB  |  303 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     String   STRING001
  25.     String   STRING002
  26.     String   STRING003
  27.     String   STRING004
  28.     String   STRING005
  29.  
  30. ;------------------------------------------------------------------------------
  31.  
  32.     Goto LABEL001
  33.     End
  34.     If (0 == 0) STRING001 = "NO"
  35.     If (0 == 1) STRING001 = "YES"
  36.  
  37.     EndFunc
  38.  
  39.     :LABEL001
  40.     STRING002 = String(PcbNode())
  41.     If (PcbNode() == 0) STRING002 = "A"
  42.     STRING005 = GetEnv(STRING002 + "RECNO")
  43.     STRING005 = ToInteger(STRING005)
  44.     STRING003 = String(Random(1000)) + "X" + STRING002
  45.     DCloseAll
  46.     DOpen 0, PPEPath() + "USER.DBF", 0
  47.     DOpen 2, PPEPath() + "ARMOR.DBF", 0
  48.     DnCreate 2, PPEPath() + STRING003 + ".NDX", "NUMBER"
  49.     DGo 0, STRING005
  50.     INTEGER001 = DRecNo(0)
  51.     If (DGet(0, "ARMOR_N") > 0) Then
  52.         DTop 2
  53.         DSeek 2, DGet(0, "ARMOR_N")
  54.         INTEGER002 = DGet(2, "DEFENSE") - DGet(0, "ARMOR_D")
  55.     Endif
  56.     :LABEL002
  57.     Cls
  58.     Newline
  59.     PrintLn "@X0C           ─╥─ ╖ ╓ ╥─╖     ╥─╖ ╓─╖ ╥─╖ ╖ ╖     ╓─╖ ╖ ╓ ╓─╖ ╥─╖@X07"
  60.     PrintLn "@X0C            ║  ╟─╢ ╟─      ╟─╢ ║ ║ ║ ║ ╙─╢     ╙─╖ ╟─╢ ║ ║ ╟─╜@X07"
  61.     PrintLn "@X0C            ╨  ╜ ╙ ╨─╜     ╨─╜ ╙─╜ ╨─╜ ──╜     ╙─╜ ╜ ╙ ╙─╜ ╨  @X07"
  62.     Newline
  63.     PrintLn "@X01   ≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡@X0F"
  64.     Newline
  65.     PrintLn "@X0E        Be sure to check out our new Armor section, where we not only@X0F"
  66.     PrintLn "@X0E   carry every type of armor from Life Pod Survival Suits (LPSS Level 2)@X0F"
  67.     PrintLn "@X0E   to Open-Air powered armor, the BEST Armor the Imperium will allows to@X0F"
  68.     PrintLn "@X0E   be sold legally, but offer full repair services for your current armor.@X0F"
  69.     Newline
  70.     PrintLn "@X01   ≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡@X0F"
  71.     Newline
  72.     If (DGet(0, "ARMOR_N") == 0) PrintLn "      @X0EYou are currently wearing: @X0BNo Armor@X0F"
  73.     If (DGet(0, "ARMOR_N") > 0) PrintLn "      @X0EYou are currently wearing: @X0B", Trim(DGet(0, "ARMOR_T"), " ") , " Armor@X0F"
  74.     Newline
  75.     PrintLn "@X0C     (@X0ER@X0C)epair Service  (@X0ES@X0C)ell Armor  (@X0EA@X0C)rmor Sales  (@X0EQ@X0C)uit back to menu@X0F"
  76.     Newlines 2
  77.     Print "    @X0A ", Trim(DGet(0, "CASH"), " "), "@X0E credits on hand - "
  78.     InputStr "@X0EPick a department, Soldier @X02> _", STRING004, 10, 1, "RSAQ", 0 + 8
  79.     If (STRING004 == "") Goto LABEL002
  80.     Select Case (STRING004)
  81.         Case "R"
  82.             INTEGER002 = DGet(2, "DEFENSE") - DGet(0, "ARMOR_D")
  83.             If (INTEGER002 < 1) Then
  84.                 Backup 80
  85.                 ClrEol
  86.                 PrintLn "@X8CYou don't need any repairs!@X0F"
  87.                 Delay (2 * 182) / 10
  88.                 Goto LABEL002
  89.             Endif
  90.             Gosub LABEL003
  91.             Goto LABEL002
  92.         Case "S"
  93.             If (ToInteger(DGet(0, "ARMOR_N")) < 4) Then
  94.                 Backup 80
  95.                 ClrEol
  96.                 PrintLn "@X8CWe aren't interested in that suit.@X0F"
  97.                 Delay (2 * 182) / 10
  98.                 Goto LABEL002
  99.             Endif
  100.             Gosub LABEL004
  101.             Goto LABEL002
  102.         Case "A"
  103.             If (DGet(0, "ARMOR_N") > 4) Then
  104.                 Backup 80
  105.                 ClrEol
  106.                 PrintLn "@X8CYou might want to sell what you're wearing first...@X0F"
  107.                 Delay (2 * 182) / 10
  108.                 Goto LABEL002
  109.             Endif
  110.             Gosub LABEL005
  111.             Goto LABEL002
  112.         Case "Q"
  113.             Goto LABEL008
  114.     End Select
  115.     :LABEL003
  116.     Cls
  117.     PrintLn "@X0C                ╓─╖ ╥─╖ ╓─╥─╖ ╓─╖ ╥─╖     ╥─╖ ╥─╖ ╥─╖ ╓─╖ ╥ ╥─╖@X07"
  118.     PrintLn "@X0C                ╟─╢ ╟┬╜ ║ ║ ║ ║ ║ ╟┬╜     ╟┬╜ ╟─  ╟─╜ ╟─╢ ║ ╟┬╜@X07"
  119.     PrintLn "@X0C                ╜ ╙ ╨ \ ╨   ╨ ╙─╜ ╨ \     ╨ \ ╨─╜ ╨   ╜ ╙ ╨ ╨ \@X07"
  120.     PrintLn "@X01  ≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡@X0F"
  121.     Newline
  122.     PrintLn "      @X0BOur Armorers are the finest.  For a low charge, we'll repair most types  "
  123.     PrintLn "      of soft, hard, and field effect armor.                                   "
  124.     Newline
  125.     PrintLn "      I see that you're eye balling that Marauder suit I'm checking for @X07"
  126.     PrintLn "      @X0BLieutenant Rico.  Nice suit, isn't it?  Wish you had one just like @X07"
  127.     PrintLn "      @X0Bit?  It costs him a hundred grand every time he wants to wear it. @X07"
  128.     PrintLn "      @X0BIt takes twenty-six man hours just to warm that suit up to ready @X07"
  129.     PrintLn "      @X0Bcondition - and that's not counting the time to arm it.@X07"
  130.     Newline
  131.     PrintLn "      @X0BLet's see what you've got there....@X07"
  132.     INTEGER005 = INTEGER002 * (DGet(0, "ARMOR_N") * 20)
  133.     INTEGER002 = DGet(2, "DEFENSE") - DGet(0, "ARMOR_D")
  134.     Newline
  135.     PrintLn "      @X0EYou need@X0C ", INTEGER002, "@X0E points of damage repaired.  @X0EAt a cost of:@X0A ", INTEGER005, "@X0F"
  136.     If (ToInteger(DGet(0, "CASH")) < INTEGER005) Then
  137.         PrintLn "       @X0CYou don't have enough cash to fully repair...@X0F"
  138.         Newline
  139.         Delay (4 * 182) / 10
  140.     Endif
  141.     Newline
  142.     PrintLn "                @X02(@X0DM@X02)@X0Aax out Repairs"
  143.     PrintLn "                @X02(@X0CQ@X02)@X0Cuit"
  144.     Newline
  145.     InputStr "                @X0AYour Choice Soldier @X02> _", STRING004, 10, 1, "MQ", 0 + 8
  146.     Select Case (STRING004)
  147.         Case "M"
  148.             DTop 2
  149.             DSeek 2, DGet(0, "ARMOR_N")
  150.             While (DGet(0, "CASH") >= DGet(0, "ARMOR_N") * 20) Do
  151.                 INTEGER004 = DGet(2, "DEFENSE") - DGet(0, "ARMOR_D")
  152.                 If (INTEGER004 < 1) Goto LABEL002
  153.                 DPut 0, "ARMOR_D", DGet(0, "ARMOR_D") + 1
  154.                 DPut 0, "CASH", DGet(0, "CASH") - DGet(0, "ARMOR_N") * 20
  155.             EndWhile
  156.             Goto LABEL002
  157.         Case "Q"
  158.             Goto LABEL002
  159.     End Select
  160.     :LABEL004
  161.     DTop 2
  162.     DSeek 2, DGet(0, "ARMOR_N")
  163.     INTEGER003 = DGet(2, "COST") * 0.67
  164.     Cls
  165.     PrintLn "@X0C           ╓─╖ ╥─╖ ╓─╥─╖ ╓─╖ ╥─╖     ╓─╖ ╓─╖ ╖   ╥─╖ ╓─╖@X0F"
  166.     PrintLn "@X0C           ╟─╢ ╟┬╜ ║ ║ ║ ║ ║ ╟┬╜     ╙─╖ ╟─╢ ║   ╟─  ╙─╖@X0F"
  167.     PrintLn "@X0C           ╜ ╙ ╨ \ ╨   ╨ ╙─╜ ╨ \     ╙─╜ ╜ ╙ ╙─╜ ╨─╜ ╙─╜@X0F"
  168.     Newline
  169.     PrintLn "@X01  ≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡@X0F"
  170.     Newline
  171.     PrintLn "  @X0BNice suit of ", Trim(DGet(0, "ARMOR_T"), " "), " armor you've got there.  I'll give you,"
  172.     PrintLn " @X0B oh, say @X0B@X0A", INTEGER003, "@X0B for it.@X0F"
  173.     Newline
  174.     PrintLn "  @X0ESound good to you?@X0F"
  175.     Newlines 2
  176.     InputStr "@X0B  Sell Armor? @X02(@X0EY@X02/@X0CN@X02) @X0A> _", STRING004, 10, 1, "YN", 0 + 8
  177.     If (STRING004 == "") Goto LABEL004
  178.     Select Case (STRING004)
  179.         Case "Y"
  180.             DPut 0, "CASH", DGet(0, "CASH") + INTEGER003
  181.             Backup 80
  182.             ClrEol
  183.             PrintLn "@X0BYou now have@X0A ", Trim(DGet(0, "CASH"), " "), "@X0B credits@X0F"
  184.             Delay (2 * 182) / 10
  185.             DPut 0, "ARMOR_N", 0
  186.             DPut 0, "ARMOR_T", "NONE"
  187.             DPut 0, "ARMOR_D", 0
  188.             Goto LABEL002
  189.         Case "N"
  190.             Goto LABEL002
  191.     End Select
  192.     Goto LABEL004
  193.     :LABEL005
  194.     Cls
  195.     StartDisp 1
  196.     PrintLn "@X0C   ╓─╖ ╥─╖ ╓─╥─╖ ╓─╖ ╥─╖     ╓─╖ ╓─╖ ╖   ╥─╖ ╓─╖@X0F"
  197.     PrintLn "@X0C   ╟─╢ ╟┬╜ ║ ║ ║ ║ ║ ╟┬╜     ╙─╖ ╟─╢ ║   ╟─  ╙─╖@X0F"
  198.     PrintLn "@X0C   ╜ ╙ ╨ \ ╨   ╨ ╙─╜ ╨ \     ╙─╜ ╜ ╙ ╙─╜ ╨─╜ ╙─╜@X0F", " @X0EYou have @X0A", Trim(DGet(0, "CASH"), " "), "@X0E credits."
  199.     PrintLn "@X01  ≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡@X0F"
  200.     PrintLn "   @X0EItem #   @X0BDESCRIPTION           @X0CDEFENSE     @X0ACOST@X0F"
  201.     DTop 2
  202.     :LABEL006
  203.     If (DEof(2)) Goto LABEL007
  204.     PrintLn "@X0E@POS:5@", DGet(2, "NUMBER"), "@X0B@POS:13@", DGet(2, "DESCRIPT"), "@X0C@POS:36@", DGet(2, "DEFENSE"), "@POS:43@@X0A", DGet(2, "COST")
  205.     DSkip 2, 1
  206.     Goto LABEL006
  207.     :LABEL007
  208.     Newline
  209.     If (DGet(0, "ARMOR_N") > 0) PrintLn "You are currently wearing:@X0B ", DGet(0, "ARMOR_T") , "@X0F"
  210.     Newline
  211.     InputStr " @X0AYour Choice Soldier @X0E(@X0CQ@X0E)@X0Cuit @X02> _", STRING004, 10, 2, "0123456789Q", 0 + 8
  212.     If (STRING004 == "Q") Goto LABEL002
  213.     DTop 2
  214.     DSeek 2, STRING004
  215.     If (ToInteger(DGet(0, "CASH")) < ToInteger(DGet(2, "COST"))) Then
  216.         Backup 80
  217.         ClrEol
  218.         PrintLn "@X0BYou only have@X0A ", Trim(DGet(0, "CASH"), " "), "@X0B credits@X0F"
  219.         Delay (2 * 182) / 10
  220.         Goto LABEL002
  221.     Endif
  222.     DPut 0, "CASH", DGet(0, "CASH") - DGet(2, "COST")
  223.     DPut 0, "ARMOR_N", ToInteger(DGet(2, "NUMBER"))
  224.     DPut 0, "ARMOR_T", DGet(2, "DESCRIPT")
  225.     DPut 0, "ARMOR_D", DGet(2, "DEFENSE")
  226.     Goto LABEL002
  227.     :LABEL008
  228.     DCloseAll
  229.     Delete PPEPath() + STRING003 + ".NDX"
  230.     End
  231.  
  232. ;------------------------------------------------------------------------------
  233. ;
  234. ; Usage report (before postprocessing)
  235. ;
  236. ; ■ Statements used :
  237. ;
  238. ;    2       End
  239. ;    4       Cls
  240. ;    5       ClrEol
  241. ;    42      Goto 
  242. ;    14      Let 
  243. ;    1       Print 
  244. ;    47      PrintLn 
  245. ;    26      If 
  246. ;    1       StartDisp 
  247. ;    1       Delete 
  248. ;    4       InputStr 
  249. ;    3       Gosub 
  250. ;    6       Delay 
  251. ;    18      Newline
  252. ;    2       Newlines 
  253. ;    5       Backup 
  254. ;    1       EndFunc
  255. ;    2       DOpen 
  256. ;    2       DCloseAll
  257. ;    1       DnCreate 
  258. ;    5       DTop 
  259. ;    1       DGo 
  260. ;    1       DSkip 
  261. ;    4       DSeek 
  262. ;    10      DPut 
  263. ;
  264. ;
  265. ; ■ Functions used :
  266. ;
  267. ;    11      *
  268. ;    6       /
  269. ;    15      +
  270. ;    6       -
  271. ;    15      ==
  272. ;    5       <
  273. ;    4       >
  274. ;    1       >=
  275. ;    16      !
  276. ;    6       Trim()
  277. ;    1       Random()
  278. ;    2       String()
  279. ;    4       PPEPath()
  280. ;    2       PcbNode()
  281. ;    1       GetEnv()
  282. ;    6       ToInteger()
  283. ;    1       DEof()
  284. ;    1       DRecNo()
  285. ;    44      DGet()
  286. ;
  287. ;------------------------------------------------------------------------------
  288. ;
  289. ; Analysis flags : No flag
  290. ;
  291. ;------------------------------------------------------------------------------
  292. ;
  293. ; Postprocessing report
  294. ;
  295. ;    0       For/Next
  296. ;    1       While/EndWhile
  297. ;    6       If/Then or If/Then/Else
  298. ;    3       Select Case
  299. ;
  300. ;------------------------------------------------------------------------------
  301. ;                 AEGiS Corp - Break the routines, code against the machines!
  302. ;------------------------------------------------------------------------------
  303.